unit chimera.rest;

interface

uses System.SysUtils, System.Classes, chimera.json, IdHTTP, IdAuthentication,
  chimera.json.variants, IdAuthenticationManager, System.Generics.Collections;

type
  TJSONValidationEvent = procedure(ASender : TObject; json : IJSONObject; var IsValid : boolean) of object;
  TJSONValidationReference = reference to procedure(ASender : TObject; json : IJSONObject; var IsValid : boolean);

  TRestClient = class(TInterfacedObject)
  private
    FURL : string;
    FHTTP : TIdHTTP;
    FRaiseExceptions: boolean;
    FOnValidateDo: TJSONValidationReference;
    FOnValidate: TJSONValidationEvent;
    function GetAuth: TIdAuthenticationManager;
    procedure SetAuth(const Value: TIdAuthenticationManager);
    procedure SetURL(const Value: string);
  protected
    procedure Initialize; virtual;
    function DoValidate(const obj : IJSONObject) : IJSONObject; inline;
  public
    constructor Create; overload; virtual;
    constructor Create(const AURL : string); overload; virtual;
    destructor Destroy; override;
    property RaiseExceptions : boolean read FRaiseExceptions write FRaiseExceptions;

    procedure AddAuthentication(const AUsername, APassword : string; const APath : String = '/');

    property HTTP : TIdHTTP read FHTTP;
    property Auth : TIdAuthenticationManager read GetAuth write SetAuth;
    property URL : string read FURL write SetURL;
    property OnValidate : TJSONValidationEvent read FOnValidate write FOnValidate;
    property OnValidateDo : TJSONValidationReference read FOnValidateDo write FOnValidateDo;

    function GetJSON(const path : string) : IJSONObject; virtual;
    function PutJSON(const path : string; const Document : IJSONObject ) : IJSONObject; virtual;
    function PostJSON(const path : string; const Document : IJSONObject) : IJSONObject; virtual;
    function DeleteJSON(const path : string) : IJSONObject; virtual;

    function Get(const path : string) : TJSON; virtual;
    function Put(const path : string; const Document : TJSON) : TJSON; virtual;
    function Post(const path : string; const Document : TJSON) : TJSON; virtual;
    function Delete(const path : string) : TJSON; virtual;
  end;

implementation

uses IdSSLOpenSSL, IdCookieManager, IdURI;

{ TRestClient }

constructor TRestClient.Create;
begin
  inherited Create;
  Initialize;
end;

procedure TRestClient.AddAuthentication(const AUsername, APassword : string; const APath : String = '/');
var
 ath : TIdAuthentication;
begin
  ath := TIdAuthentication.Create;
  ath.Username := AUsername;
  ath.Password := APassword;
  Auth.AddAuthentication(ath, TIdURI.Create(FURL+APath));
end;

constructor TRestClient.Create(const AURL: string);
var
  auth : TIdAuthentication;
begin
  inherited Create;
  Initialize;
  auth := TIdAuthentication.Create;
  FURL := AURL;
  if (FURL <> '') and (FURL[length(FURL)] = '/') then
    System.Delete(FURL,Length(FURL),1);
end;

function TRestClient.Delete(const path: string): TJSON;
begin
  Result := chimera.json.variants.JSON(DeleteJSON(path));
end;

function TRestClient.DeleteJSON(const path: string): IJSONObject;
var
  sResult : string;
begin
  try
    FHTTP.Delete(FURL+Path);
  except
    on E: EIdHTTPProtocolException do
      if FRaiseExceptions then
        raise;
    else
      raise;
  end;
  SetLength(sResult,FHTTP.Response.ContentStream.Size);
  if FHTTP.Response.ContentStream.Size > 0 then
  begin
    FHTTP.Response.ContentStream.Position := 0;
    FHTTP.Response.ContentStream.Read(sResult[1],FHTTP.Response.ContentStream.Size);
  end;
  sResult := Trim(sResult);

  if not StringIsJSON(sResult) then
  begin
    Result := chimera.json.JSON;
    Result.Strings['response'] := sResult;
  end else
    Result := DoValidate(chimera.json.JSON(sResult));
end;

destructor TRestClient.Destroy;
begin
  FHTTP.Free;
  inherited;
end;

function TRestClient.DoValidate(const obj: IJSONObject): IJSONObject;
var
  bValid : boolean;
begin
  Result := obj;

  bValid := True;
  if Assigned(FOnValidate) then
    FOnValidate(Self, Result, bValid);

  if Assigned(FOnValidateDo) then
    FOnValidateDo(Self, Result, bValid);

  if not bValid then
    Abort;
end;

function TRestClient.GetJSON(const path: string): IJSONObject;
var
  sResult : string;
begin
  try
    sResult := FHTTP.Get(FURL+path);
  except
    on E: EIdHTTPProtocolException do
      if FRaiseExceptions then
        raise;
    else
      raise;
  end;
  if not StringIsJSON(sResult) then
  begin
    Result := chimera.json.JSON;
    Result.Strings['response'] := sResult;
  end else
    Result := DoValidate(chimera.json.JSON(sResult));
end;

function TRestClient.Get(const path: string): TJSON;
begin
  Result := chimera.json.variants.JSON(GetJSON(path));
end;

function TRestClient.GetAuth: TIdAuthenticationManager;
begin
  Result := FHTTP.AuthenticationManager;
end;

procedure TRestClient.Initialize;
begin
  FRaiseExceptions := True;
  FHTTP := TIdHTTP.Create;
  FHTTP.CookieManager := TIdCookieManager.Create(FHTTP);
  FHTTP.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(FHTTP);
  FHTTP.HandleRedirects := True;
  FHTTP.AuthenticationManager := TIdAuthenticationManager.Create(FHTTP);
end;

function TRestClient.Post(const path: string; const Document: TJSON): TJSON;
begin
  Result := chimera.json.variants.JSON(PostJSON(path, VariantToJSONObject(Document)));
end;

function TRestClient.PostJSON(const path: string;
  const Document: IJSONObject): IJSONObject;
var
  sJSON : string;
  ms : TMemoryStream;
begin
  sJSON := Document.AsJSON;
  ms := TMemoryStream.Create;
  try
    ms.Write(sJSON[1],length(sJSON));
    ms.Position := 0;
    try
      FHTTP.Request.ContentType := 'application/json';
      sJSON := FHTTP.Post(FURL+path, ms);
    except
      on E: EIdHTTPProtocolException do
        if FRaiseExceptions then
          raise;
      else
        raise;
    end;
  finally
    ms.Free;
  end;
  if not StringIsJSON(sJSON) then
  begin
    Result := chimera.json.JSON;
    Result.Strings['response'] := sJSON;
  end else
    Result := DoValidate(chimera.json.JSON(sJSON));
end;

function TRestClient.Put(const path: string; const Document: TJSON): TJSON;
begin
  Result := chimera.json.variants.JSON(PutJSON(path, VariantToJSONObject(Document)));
end;

function TRestClient.PutJSON(const path: string;
  const Document: IJSONObject): IJSONObject;
var
  sJSON : string;
  ms : TMemoryStream;
begin
  sJSON := Document.AsJSON;
  ms := TMemoryStream.Create;
  try
    ms.Write(sJSON[1],length(sJSON));
    ms.Position := 0;
    try
      FHTTP.Request.ContentType := 'application/json';
      sJSON := FHTTP.Put(FURL+path, ms);
    except
      on E: EIdHTTPProtocolException do
        if FRaiseExceptions then
          raise;
      else
        raise;
    end;
  finally
    ms.Free;
  end;
  if not StringIsJSON(sJSON) then
  begin
    Result := chimera.json.JSON;
    Result.Strings['response'] := sJSON;
  end else
    Result := DoValidate(chimera.json.JSON(sJSON));
end;

procedure TRestClient.SetAuth(const Value: TIdAuthenticationManager);
begin
  FHTTP.AuthenticationManager.Assign(Value);
end;

procedure TRestClient.SetURL(const Value: string);
begin
  FURL := Value;
  if (FURL <> '') and (FURL[length(FURL)] = '/') then
    System.Delete(FURL,Length(FURL),1);
end;

end.
